pacman::p_load(tmap, sf, tidyverse, knitr,dplyr,mapview)Take-Home-EX01
Getting Started
Loading R packages
Imorting Data
Importing geospatial data
busstop <- st_read(dsn = "data/geospatial", layer = "BusStop")Reading layer `BusStop' from data source
`D:\zzc\ISSS624\Take-home-Ex1\data\Geospatial' using driver `ESRI Shapefile'
Simple feature collection with 5161 features and 3 fields
Geometry type: POINT
Dimension: XY
Bounding box: xmin: 3970.122 ymin: 26482.1 xmax: 48284.56 ymax: 52983.82
Projected CRS: SVY21
Importing OD data
odbus = st_read("data/Apstial/origin_destination_bus_202308.csv")Reading layer `origin_destination_bus_202308' from data source
`D:\zzc\ISSS624\Take-home-Ex1\data\Apstial\origin_destination_bus_202308.csv'
using driver `CSV'
Warning: no simple feature geometries present: returning a data.frame or tbl_df
odbus$ORIGIN_PT_CODE <- as.factor(odbus$ORIGIN_PT_CODE)
odbus$DESTINATION_PT_CODE <- as.factor(odbus$DESTINATION_PT_CODE)
odbus$TOTAL_TRIPS <- as.numeric(odbus$TOTAL_TRIPS)Extracting the data
Weekday morning peak
odbus6_9 <- odbus %>%
filter(DAY_TYPE == "WEEKDAY") %>%
filter(TIME_PER_HOUR >= 6 &
TIME_PER_HOUR <= 9) %>%
group_by(ORIGIN_PT_CODE,
DESTINATION_PT_CODE) %>%
summarise(TRIPS = sum(TOTAL_TRIPS))`summarise()` has grouped output by 'ORIGIN_PT_CODE'. You can override using
the `.groups` argument.
Weekday afternoon peak
odbus17_20 <- odbus %>%
filter(DAY_TYPE == "WEEKDAY") %>%
filter(TIME_PER_HOUR >= 17 &
TIME_PER_HOUR <= 20) %>%
group_by(ORIGIN_PT_CODE,
DESTINATION_PT_CODE) %>%
summarise(TRIPS = sum(TOTAL_TRIPS))`summarise()` has grouped output by 'ORIGIN_PT_CODE'. You can override using
the `.groups` argument.
Weekend/holiday morning peak
odbus11_14 <- odbus %>%
filter(DAY_TYPE == "WEEKENDS/HOLIDAY") %>%
filter(TIME_PER_HOUR >= 11 &
TIME_PER_HOUR <= 14) %>%
group_by(ORIGIN_PT_CODE,
DESTINATION_PT_CODE) %>%
summarise(TRIPS = sum(TOTAL_TRIPS))`summarise()` has grouped output by 'ORIGIN_PT_CODE'. You can override using
the `.groups` argument.
Weekend/holiday evening peak
odbus16_19 <- odbus %>%
filter(DAY_TYPE == "WEEKENDS/HOLIDAY") %>%
filter(TIME_PER_HOUR >= 16 &
TIME_PER_HOUR <= 19) %>%
group_by(ORIGIN_PT_CODE,
DESTINATION_PT_CODE) %>%
summarise(TRIPS = sum(TOTAL_TRIPS))`summarise()` has grouped output by 'ORIGIN_PT_CODE'. You can override using
the `.groups` argument.
Create Hexagon grid
area_honeycomb_grid = st_make_grid(busstop, cellsize = 500, what = "polygons", square = FALSE)
# To sf and add grid ID
honeycomb_grid_sf = st_sf(area_honeycomb_grid) %>%
# add grid ID
mutate(grid_id = 1:length(lengths(area_honeycomb_grid)))Geospatial data wrangling
Combining Busstop and mpsz
busstop_hexagon <- st_intersection(busstop, honeycomb_grid_sf) %>%
select(BUS_STOP_N, grid_id) %>%
st_drop_geometry()Warning: attribute variables are assumed to be spatially constant throughout
all geometries
write_rds(busstop_hexagon, "data/rds/busstop_hexagon.csv") Left join weekday morning peak
od_data1 <- left_join(odbus6_9 , busstop_hexagon,
by = c("ORIGIN_PT_CODE" = "BUS_STOP_N")) %>%
rename(ORIGIN_BS = ORIGIN_PT_CODE,
ORIGIN_SZ = grid_id) %>%
group_by(ORIGIN_BS,ORIGIN_SZ) %>%
summarise(TOT_TRIPS = sum(TRIPS))Warning in left_join(odbus6_9, busstop_hexagon, by = c(ORIGIN_PT_CODE = "BUS_STOP_N")): Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 25446 of `x` matches multiple rows in `y`.
ℹ Row 3153 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
"many-to-many"` to silence this warning.
`summarise()` has grouped output by 'ORIGIN_BS'. You can override using the
`.groups` argument.
Left join weekday afternoon peak
od_data2 <- left_join(odbus17_20 , busstop_hexagon,
by = c("ORIGIN_PT_CODE" = "BUS_STOP_N")) %>%
rename(ORIGIN_BS = ORIGIN_PT_CODE,
ORIGIN_SZ = grid_id) %>%
group_by(ORIGIN_BS,ORIGIN_SZ) %>%
summarise(TOT_TRIPS = sum(TRIPS))Warning in left_join(odbus17_20, busstop_hexagon, by = c(ORIGIN_PT_CODE = "BUS_STOP_N")): Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 35040 of `x` matches multiple rows in `y`.
ℹ Row 3153 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
"many-to-many"` to silence this warning.
`summarise()` has grouped output by 'ORIGIN_BS'. You can override using the
`.groups` argument.
Left join weekend/holiday morning peak
od_data3 <- left_join(odbus11_14 , busstop_hexagon,
by = c("ORIGIN_PT_CODE" = "BUS_STOP_N")) %>%
rename(ORIGIN_BS = ORIGIN_PT_CODE,
ORIGIN_SZ = grid_id) %>%
group_by(ORIGIN_BS,ORIGIN_SZ) %>%
summarise(TOT_TRIPS = sum(TRIPS))Warning in left_join(odbus11_14, busstop_hexagon, by = c(ORIGIN_PT_CODE = "BUS_STOP_N")): Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 27356 of `x` matches multiple rows in `y`.
ℹ Row 3153 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
"many-to-many"` to silence this warning.
`summarise()` has grouped output by 'ORIGIN_BS'. You can override using the
`.groups` argument.
Left join weekend/holiday evening peak
od_data4 <- left_join(odbus16_19 , busstop_hexagon,
by = c("ORIGIN_PT_CODE" = "BUS_STOP_N")) %>%
rename(ORIGIN_BS = ORIGIN_PT_CODE,
ORIGIN_SZ = grid_id) %>%
group_by(ORIGIN_BS,ORIGIN_SZ) %>%
summarise(TOT_TRIPS = sum(TRIPS))Warning in left_join(odbus16_19, busstop_hexagon, by = c(ORIGIN_PT_CODE = "BUS_STOP_N")): Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 28535 of `x` matches multiple rows in `y`.
ℹ Row 3153 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
"many-to-many"` to silence this warning.
`summarise()` has grouped output by 'ORIGIN_BS'. You can override using the
`.groups` argument.
Checking duplicate records
duplicate1 <- od_data1 %>%
group_by_all() %>%
filter(n()>1) %>%
ungroup()
duplicate2 <- od_data2 %>%
group_by_all() %>%
filter(n()>1) %>%
ungroup()
duplicate3 <- od_data3 %>%
group_by_all() %>%
filter(n()>1) %>%
ungroup()
duplicate4 <- od_data4 %>%
group_by_all() %>%
filter(n()>1) %>%
ungroup()Retain unique records
od_data1 <- unique(od_data1)
od_data2 <- unique(od_data2)
od_data3 <- unique(od_data3)
od_data4 <- unique(od_data4)Update od_data data frame with the grid id
origintrip1 <- left_join(honeycomb_grid_sf,
od_data1,
by = c("grid_id" = "ORIGIN_SZ"))origintrip2 <- left_join(honeycomb_grid_sf,
od_data2,
by = c("grid_id" = "ORIGIN_SZ"))origintrip3 <- left_join(honeycomb_grid_sf,
od_data3,
by = c("grid_id" = "ORIGIN_SZ"))origintrip4 <- left_join(honeycomb_grid_sf,
od_data4,
by = c("grid_id" = "ORIGIN_SZ"))Remove grid without value of 0
origintrip1 = filter(origintrip1, TOT_TRIPS > 0)
origintrip2 = filter(origintrip2, TOT_TRIPS > 0)
origintrip3 = filter(origintrip3, TOT_TRIPS > 0)
origintrip4 = filter(origintrip4, TOT_TRIPS > 0)Creating Interactive map
tmap_mode("view")tmap mode set to interactive viewing
tmap_options(check.and.fix = TRUE)
tm_shape(origintrip1)+
tm_fill("TOT_TRIPS",
style = "quantile",
palette = "Blues",
title = "Passenger trips") +
tm_layout(main.title = "Passenger trips generated at planning sub-zone level",
main.title.position = "center",
main.title.size = 1.2,
legend.height = 0.45,
legend.width = 0.35,
frame = TRUE) +
tm_borders(alpha = 0.5) +
tm_scale_bar() +
tm_grid(alpha =0.2) tmap_mode("view")tmap mode set to interactive viewing
tmap_options(check.and.fix = TRUE)
tm_shape(origintrip2)+
tm_fill("TOT_TRIPS",
style = "quantile",
palette = "Blues",
title = "Passenger trips") +
tm_layout(main.title = "Passenger trips generated at planning sub-zone level",
main.title.position = "center",
main.title.size = 1.2,
legend.height = 0.45,
legend.width = 0.35,
frame = TRUE) +
tm_borders(alpha = 0.5) +
tm_scale_bar() +
tm_grid(alpha =0.2)tmap_mode("view")tmap mode set to interactive viewing
tmap_options(check.and.fix = TRUE)
tm_shape(origintrip3)+
tm_fill("TOT_TRIPS",
style = "quantile",
palette = "Blues",
title = "Passenger trips") +
tm_layout(main.title = "Passenger trips generated at planning sub-zone level",
main.title.position = "center",
main.title.size = 1.2,
legend.height = 0.45,
legend.width = 0.35,
frame = TRUE) +
tm_borders(alpha = 0.5) +
tm_scale_bar() +
tm_grid(alpha =0.2)tmap_mode("view")tmap mode set to interactive viewing
tmap_options(check.and.fix = TRUE)
tm_shape(origintrip4)+
tm_fill("TOT_TRIPS",
style = "quantile",
palette = "Blues",
title = "Passenger trips") +
tm_layout(main.title = "Passenger trips generated at planning sub-zone level",
main.title.position = "center",
main.title.size = 1.2,
legend.height = 0.45,
legend.width = 0.35,
frame = TRUE) +
tm_borders(alpha = 0.5) +
tm_scale_bar() +
tm_grid(alpha =0.2)